home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 2
/
The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO
/
pascal
/
encipher.zip
/
ENCIPHER.PAS
next >
Wrap
Pascal/Delphi Source File
|
1986-01-21
|
4KB
|
156 lines
PROGRAM ENCIPHER(fileName);
{This program may be freely copied and modified.}
TYPE
extension = STRING[4];
name = STRING[14];
VAR
fileName: FILE;
i, stop, blocks: INTEGER;
answer: CHAR;
fileIn: name;
transKey, subKey: ARRAY[0..127] OF INTEGER;
buffer: ARRAY[0..MAXINT] OF CHAR;
ext: extension;
FUNCTION fileExist(fileName: name): BOOLEAN; {Test to
see if file already exists.}
VAR
testFile: FILE;
BEGIN
ASSIGN(testFile, fileName); {$I-}
RESET(testFile); {$I+}
IF IORESULT <> 0 THEN fileExist:= FALSE ELSE fileExist:=TRUE;
END;
PROCEDURE initialize; {Reads in the substitution and transposition
keys from keyFile.}
VAR
dataFile: TEXT;
BEGIN
ASSIGN(dataFile,'keyFile');
RESET(dataFile);
FOR i:= 0 TO 127 DO READ(dataFile,subKey[i]);
READLN(dataFile);
FOR i:= 0 TO 63 DO READ(dataFile,transKey[i]);
CLOSE(dataFile);
END; {of initialize}
PROCEDURE transpose; {Transposes 64 characters with the next 64
using the transpose key.}
VAR
tempstore: CHAR;
switchIndex, increment: INTEGER;
BEGIN
increment:= 63; i:= 0;
WHILE i < stop DO
BEGIN
tempstore:= buffer[i];
switchIndex:= increment + transKey[i MOD 64];
buffer[i]:= buffer[switchIndex];
buffer[switchIndex]:= tempstore;
i:= i+1;
IF i MOD 64 = 0 THEN
BEGIN
i:= i + 64;
increment:= increment + 128;
END;
END;
END; {of transpose}
PROCEDURE logicalXor; {Performs a logical xor of the file with the
substitution key.}
BEGIN
FOR i:= 0 TO stop - 1 DO
buffer[i]:= CHR(ORD(buffer[i]) XOR subKey[i MOD 128]);
END; {of logicalXor}
PROCEDURE readFile; {Reads in the file to be encrypted or decrypted
and finds the file size.}
BEGIN
READLN(fileIn);
WRITELN;
ASSIGN(fileName,fileIn);
RESET(fileName);
blocks:= FILESIZE(fileName);
stop:= 128*blocks - 1;
BLOCKREAD(fileName,buffer,blocks);
CLOSE(fileName);
END; {of readFile}
PROCEDURE writeFile(VAR ext: extension); {Writes the encrypted or
decrypted file and renames with ext.}
VAR
period: INTEGER;
BEGIN
CASE answer OF
'E','e': WRITELN(fileIn,' is to be ENCRYPTED. Enter Y or N.');
'D','d': WRITELN(fileIn,' is to be DECRYPTED. Enter Y or N.');
END;
READLN(answer);
IF answer IN ['y','Y'] THEN
BEGIN
REWRITE(fileName);
BLOCKWRITE(fileName,buffer,blocks);
CLOSE(fileName);
period:= POS('.',fileIn);
IF period > 0 THEN DELETE(fileIn,period,4);
fileIn:= fileIn + ext;
IF fileExist(fileIn) THEN
WRITELN('NOTE! DUPLICATE NAMES. ORIGINAL FILE NAME KEPT.')
ELSE RENAME(fileName,fileIn);
END
ELSE WRITELN('FINAL FILE NOT WRITTEN. ORIGINAL FILE INTACT.');
END; {of writeFile}
PROCEDURE encrypt; {Encryption as substitution, transposition,
and logical xor.}
BEGIN
WRITELN('Enter the name of the file you wish to ENCRYPT:');
readFile;
FOR i:= 0 TO stop-1 DO
buffer[i]:= CHR(ORD(buffer[i]) + subKey[i MOD 128]);
transpose;
logicalXor;
ext:= '.enc';
writeFile(ext);
END; {of encrypt}
PROCEDURE decrypt; {Decryption as the inverse of encryption.}
BEGIN
WRITELN('Enter the name of the file you wish to DECRYPT');
readFile;
logicalXor;
transpose;
FOR i:= 0 TO stop-1 DO
buffer[i]:= CHR(ORD(buffer[i]) - subKey[i MOD 128]);
ext:= '.clr';
writeFile(ext);
END; {of decrypt}
{ ***** END OF PROCEDURES ***** }
BEGIN
initialize;
WRITELN('Encrypt, Decrypt, or Terminate (E/D/T)?');
WRITELN;
READLN(answer);
CASE answer OF
'E','e': encrypt;
'D','d': decrypt;
'T','t': WRITELN('TERMINATING. NO ACTION TAKEN.');
ELSE WRITELN('ILLEGAL RESPONSE. TERMINATING. NO ACTION TAKEN.');
END;
END.